home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / nannws33.zip / DB_DEMO.PRG < prev    next >
Text File  |  1988-11-01  |  13KB  |  632 lines
  1. * Program: Db_demo.prg
  2. * Author:  Don L. Powells
  3. * Version: Summer '87
  4. * Note(s): Routine to demonstrate DBEDIT()
  5. *          with a user-defined function.
  6. *
  7. *          Database Files:
  8. *            Customer.dbf   Serialno.dbf
  9. *          Index Files:
  10. *            Cust_no.NTX    State.ntx
  11. *            Company.NTX    Zip.NTX
  12. *            Last.ntx
  13. *
  14. * Copyright (c) 1988 Nantucket Corp.
  15.  
  16. * Save original DOS screen to restore
  17. * upon exit.
  18. SAVE SCREEN TO dosscrn
  19. CLEAR SCREEN
  20. SET WRAP ON
  21. beep_on = .T.   && Turn on Beep function.
  22.  
  23. * Open the database and associated indexes.
  24. USE Customer
  25. SET INDEX TO Company,Cust_no,Last,Zip,State
  26.  
  27. * Declare and initialize arrays and memory
  28. * variable parameters.
  29. t = 6
  30. l = 1
  31. b = 20
  32. r = 78
  33.  
  34. DECLARE fields[FCOUNT()-1],pics[FCOUNT()-1],;
  35.    heads[FCOUNT()-1],foots[FCOUNT()-1]
  36.  
  37. * Fill fields array with field names.
  38. AFIELDS(fields)
  39.  
  40. udf = "Db_func"
  41.  
  42. AFILL(pics,"")
  43. pics[3] = "@R 999-999-9999"
  44. pics[9] = "99999-9999"
  45. pics[11] = "@!"
  46.  
  47. heads[1] = "Customer No."
  48. heads[2] = "Company Name"
  49. heads[3] = "Phone No."
  50. heads[4] = "Extension"
  51. heads[5] = "Address"
  52. heads[6] = "Address"
  53. heads[7] = "City"
  54. heads[8] = "State"
  55. heads[9] = "Zip code"
  56. heads[10] = "First Name"
  57. heads[11] = "MI"
  58. heads[12] = "Last Name"
  59.  
  60. headsep = CHR(205)   && CHR(205) = '═'
  61. colsep = CHR(179)    && CHR(179) = '│'
  62. footsep = CHR(196)   && CHR(196) = '─'
  63.  
  64. foots[1] = "NO EDIT Allowed"
  65. foots[5] = "Line one"
  66. foots[6] = "Line two"
  67.  
  68. * Incremental seek string for speed scroll.
  69. mstring = ""
  70.  
  71. * Draw screen constants.
  72. Saycenter(1,"Clipper Summer 87")
  73. Saycenter(2,"DBEDIT() Demo")
  74. @ 3,0 SAY REPLICATE(CHR(196),80)
  75. * Draw box to surround table.
  76. @ 5,0 TO 21,79
  77.  
  78. * Draw Browse menu.
  79. Saycenter(22,"<ESC>:Exit <Return>:Edit "+;
  80.    "<F3>:Order <Del>:Del/Recall <F4>:Pack")
  81.  
  82. * If Empty file force EOF() bang and user
  83. * function call.
  84. IF RECCOUNT() = 0
  85.    KEYBOARD CHR(24)
  86. ENDIF
  87.  
  88. * Call DBEDIT() and start browsing.
  89. DBEDIT(t,l,b,r,fields,udf,pics,heads,headsep,;
  90.    colsep,footsep,foots)
  91. CLOSE DATABASES
  92. RESTORE SCREEN FROM dosscrn
  93. RETURN
  94.  
  95.  
  96. * Db_func() - User-defined function
  97. * for DBEDIT().
  98. *
  99. FUNCTION Db_func
  100. PARAMETERS mstatus,fld_ptr
  101. PRIVATE request
  102.  
  103. * Assume normal return.
  104. request = 1
  105.  
  106. * Save last keystroke.
  107. keystroke = LASTKEY()
  108.  
  109. * Assign current field name to mem variable.
  110. curfield = fields[fld_ptr]
  111.  
  112. * Save current cursor position.
  113. mrow = ROW()
  114. mcol = COL()
  115.  
  116. IF mstatus = 0
  117.    * Idle.
  118.    request = Idlestat()
  119.       
  120. ELSEIF mstatus = 1
  121.    * Beginning-of-file.
  122.    request = Pasttop()
  123.  
  124. ELSEIF mstatus = 2
  125.    * End-of-file.
  126.    request = Pastbott(curfield)
  127.  
  128. ELSEIF mstatus = 3
  129.    * Empty database file.
  130.    request = Emptydbf(curfield,fld_ptr)
  131.  
  132. ELSEIF mstatus = 4
  133.    * Keystroke exception.
  134.    request = Keyexcep(keystroke,curfield,fld_ptr,mrow,mcol)
  135.  
  136. ELSE
  137.    request = Idlestat()
  138.  
  139. ENDIF
  140. RETURN(request)
  141.  
  142. * Idlestat()
  143. * Process idle status (0) of DBEDIT().
  144. * Updates record number and deleted status.
  145. *
  146. FUNCTION Idlestat
  147. mrecno = RECNO()
  148. @ 1,60 SAY "Record " +;
  149.    ALLTRIM(TRANSFORM(mrecno,"@Z"))
  150. IF DELETED()
  151.    @ 2,60 SAY "** DELETED **"
  152. ELSE
  153.    @ 2,60 SAY "             "
  154. ENDIF
  155.  
  156. morder = INDEXORD()
  157. @ 2,5 SAY "Order: "+ UPPER(INDEXKEY(morder))+;
  158.    SPACE(5)
  159.  
  160. * Draw Incremental Seek Prompt.
  161. @ 23,0 SAY "Enter " + TRIM(INDEXKEY(0))+":   "
  162.  
  163. @ 4,0
  164. Saycenter(4,"BROWSE MODE")
  165. RETURN(1)
  166.  
  167.  
  168. * Pasttop()
  169. * Process status (1) of DBEDIT().
  170. *
  171. FUNCTION Pasttop
  172. Beep("NORM")
  173. @ 0,0
  174. @ 0,0 SAY "** Beginning of File **"
  175. INKEY(.5)
  176. @ 0,0
  177. RETURN(1)
  178.  
  179.  
  180. * Pastbott()
  181. * Process status (2) of DBEDIT().
  182. *
  183. FUNCTION Pastbott
  184. PRIVATE curfield,retval
  185. PARAMETERS curfield
  186. @ 0,0
  187. @ 0,0 SAY "** End of File **"
  188. Beep("NORM")
  189. retval = Apendrec(curfield)
  190. @ 0,0
  191. RETURN(retval)
  192.  
  193.  
  194. * Apendrec()
  195. * Append a blank record to the file.
  196. *
  197. FUNCTION Apendrec
  198. PRIVATE curfield,fld_ptr,retval
  199. PARAMETERS curfield, fld_ptr
  200. retval = 1
  201. @ 4,0
  202. Saycenter(4,"BROWSE MODE")
  203. resp = "N"
  204. @ 24,0
  205. @ 24,0 SAY "Do you want to add a new " + ;
  206.    "record (Y/N)? " GET resp PICTURE "@!"
  207. READ
  208. @ 24,0
  209. IF resp = "Y"
  210.    APPEND BLANK
  211.    * Get the next unique serial number from
  212.    * the serial number file.
  213.    currarea = SELECT()
  214.    SELECT 0
  215.    USE Serialno
  216.    mCust_no = Ser_num + 1
  217.    REPLACE Ser_num WITH mCust_no
  218.    USE
  219.    SELECT (currarea)
  220.    REPLACE Cust_no WITH mCust_no
  221.    IF curfield != "CUST_NO"
  222.       Fld_edit(curfield,fld_ptr)
  223.    ENDIF
  224.    retval = 2
  225.    Idlestat()
  226. ENDIF
  227. RETURN(retval)
  228.  
  229.  
  230. * Emptydbf()
  231. * Process status (3) of DBEDIT().
  232. *
  233. FUNCTION Emptydbf
  234. PRIVATE curfield,fld_ptr,retval
  235. PARAMETERS curfield, fld_ptr
  236. * Enter append mode.
  237. request = Apendrec(curfield,fld_ptr)
  238. * Display status.
  239. Idlestat()
  240. RETURN(retval)
  241.  
  242.  
  243. * Keyexcep()
  244. * Process keystroke exceptions.
  245. *
  246. FUNCTION Keyexcep
  247. PRIVATE request,keystroke,curfield,;
  248.    fld_ptr,mrow,mcol
  249. PARAMETERS keystroke,curfield,fld_ptr,;
  250.    mrow,mcol
  251. IF keystroke = 27       && <ESC>.
  252.    * Exit.
  253.    request = 0
  254.  
  255. ELSEIF keystroke = 13
  256.    * Edit current cell.
  257.    request = Fld_edit(curfield,fld_ptr)
  258.  
  259. ELSEIF keystroke = 7    && <Del>.
  260.    * Delete/Recall current record.
  261.    request = Delrecall()
  262.  
  263. ELSEIF keystroke = -2   && <F3>.
  264.    * Select index order.
  265.    request = Pickordr()
  266.       
  267. ELSEIF keystroke = -3   && <F4>.
  268.    * Pack the file.
  269.    request = Fil_pack()
  270.  
  271. ELSEIF ASC(CHR(keystroke)) >= 32 .AND.;
  272.    ASC(CHR(keystroke)) <= 126  && Alphanumeric
  273.    * Speed Scroll/Incremental Seek.
  274.    request = Incseek(curfield,keystroke)
  275.  
  276. ELSEIF keystroke = 8    && <Backspace>.
  277.    * Decremental Seek.
  278.    request = Decseek()
  279.  
  280. ELSE
  281.    Not_yet()
  282.    request = 1
  283. ENDIF
  284.  
  285. RETURN(request)
  286.  
  287.  
  288. * Delrecall()
  289. * Delete/Recall records toggle.
  290. *
  291. FUNCTION Delrecall
  292. IF DELETED()
  293.    RECALL
  294. ELSE
  295.    DELETE
  296. ENDIF
  297. * Update Deleted status.
  298. Idlestat()
  299. RETURN(1)
  300.  
  301.  
  302. * Pickordr()
  303. * Select the index order for file.
  304. *
  305. FUNCTION Pickordr
  306. PRIVATE retval,ntxcnt,ntxkey,maxntx,subscrpt,;
  307.    tr,lc,br,rc,ordscrn
  308. retval = 1
  309. * Count the number of indexes.
  310. ntxcnt = 0
  311. ntxkey = INDEXKEY(ntxcnt)
  312. IF "" != ntxkey
  313.    DO WHILE "" != ntxkey
  314.       ntxcnt = ntxcnt + 1
  315.       ntxkey = INDEXKEY(ntxcnt)
  316.    ENDDO
  317.    * Display menu of keys.
  318.    DECLARE ntxarray[ntxcnt]
  319.    maxntx = 0
  320.    FOR i = 1 TO ntxcnt
  321.       ntxarray[i] = INDEXKEY(i)
  322.       maxntx = MAX(LEN(ntxarray[i]),maxntx)
  323.    NEXT
  324.    tr = 8
  325.    lc = (80 - maxntx)/2
  326.    br = 15
  327.    rc = lc + maxntx
  328.    ordscrn = SAVESCREEN((tr - 2),(lc - 1),;
  329.       (br + 1), (rc + 1))
  330.    @ 4,0
  331.    Saycenter(4,"Select Order")
  332.    @ (tr - 1),(lc - 1) TO (br + 1), (rc + 1)
  333.    SCROLL(tr,lc,br,rc,0)
  334.    subscrpt = ACHOICE(tr,lc,br,rc,ntxarray)
  335.    IF subscrpt != 0
  336.       SET ORDER TO subscrpt
  337.       @ 23,0
  338.       mstring = ""
  339.    ENDIF
  340.    RESTSCREEN((tr - 2),(lc - 1),(br + 1),;
  341.       (rc + 1),ordscrn)
  342.    retval = 2
  343. ELSE
  344.    Beep("BOZO")
  345.    Err_msg("No index files are available.")
  346. ENDIF
  347. Idlestat()
  348. RETURN(retval)
  349.  
  350.  
  351. * Fil_pack()
  352. * Remove deleted records from the file.
  353. *
  354. FUNCTION Fil_pack
  355. Beep("NORM")
  356. retval = 1
  357. resp = "N"
  358. @ 0,0
  359. @ 0,0 SAY "Record removal is permanent. " + ;
  360.    "Continue?(Y/N) ";
  361.     GET resp PICTURE "@!" VALID(resp $ "Y/N")
  362. READ
  363. @ 0,0
  364. IF resp = "Y"
  365.    @ 24,0
  366.    @ 24,0 SAY "Removing deleted records..."
  367.    PACK
  368.    retval =2
  369.    @ 24,0
  370.    Idlestat()
  371. ENDIF
  372. RETURN(retval)
  373.  
  374.  
  375. * Fld_edit()
  376. * Edit cell contents in table using
  377. * memory variable.
  378. *
  379. FUNCTION Fld_edit
  380. PRIVATE curfield,fld_ptr
  381. PARAMETERS curfield,fld_ptr
  382. @ 4,0
  383. Saycenter(4,"EDIT MODE")
  384. * Assume no screen refresh.
  385. retval = 1
  386.  
  387. * Get controlling index key.
  388. ntx_expr = INDEXKEY(0)
  389. * Expand for comparison after edit to determine
  390. * whether screen refresh is needed.
  391. ntx_eval = &ntx_expr
  392. SET CURSOR ON       && DBEDIT() turns
  393.                     ** cursor off by default.
  394.  
  395. * Store field contents to memory variable.
  396. get_data = &curfield.
  397.  
  398. * Allow up and down arrows to exit READ.
  399. READEXIT(.T.)
  400.  
  401. * Prevent edits on Customer number field.
  402. IF curfield != "CUST_NO"
  403.    @ mrow,mcol GET get_data;
  404.       PICTURE get_pic(curfield,fld_ptr)
  405.    READ
  406.  
  407.    * Turn off up, down arrow ke